VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmMain 
   Appearance      =   0  'Flat
   BackColor       =   &H00571A4E&
   Caption         =   "LAN Messenger"
   ClientHeight    =   8475
   ClientLeft      =   225
   ClientTop       =   555
   ClientWidth     =   10470
   BeginProperty Font 
      Name            =   "Segoe UI"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   Picture         =   "frmMain2.frx":0000
   ScaleHeight     =   8475
   ScaleWidth      =   10470
   StartUpPosition =   3  'Windows Default
   Begin VB.OptionButton Opttxt 
      Appearance      =   0  'Flat
      BackColor       =   &H0013E1A4&
      Caption         =   "Chat"
      BeginProperty Font 
         Name            =   "Segoe UI"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000005&
      Height          =   375
      Left            =   240
      TabIndex        =   8
      Top             =   7080
      Value           =   -1  'True
      Width           =   975
   End
   Begin VB.OptionButton OptFileSend 
      Appearance      =   0  'Flat
      BackColor       =   &H0013E1A4&
      Caption         =   "Send File"
      BeginProperty Font 
         Name            =   "Segoe UI"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   375
      Left            =   240
      MaskColor       =   &H00FFFFFF&
      Picture         =   "frmMain2.frx":2DD67
      TabIndex        =   7
      Top             =   6600
      UseMaskColor    =   -1  'True
      Width           =   1095
   End
   Begin MSComDlg.CommonDialog cdOpen 
      Left            =   9360
      Top             =   6360
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.TextBox Status 
      Appearance      =   0  'Flat
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "Segoe UI Semibold"
         Size            =   12
         Charset         =   0
         Weight          =   600
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0013E1A4&
      Height          =   405
      Left            =   3000
      TabIndex        =   6
      Text            =   "Hi!!"
      Top             =   120
      Width           =   4815
   End
   Begin MSWinsockLib.Winsock wsUdp 
      Left            =   9960
      Top             =   6360
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      Protocol        =   1
   End
   Begin VB.TextBox txtOut 
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "Segoe UI Semibold"
         Size            =   9.75
         Charset         =   0
         Weight          =   600
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0013E1A4&
      Height          =   1575
      Left            =   3240
      MultiLine       =   -1  'True
      TabIndex        =   3
      Text            =   "frmMain2.frx":306BC
      Top             =   6480
      Width           =   5535
   End
   Begin VB.TextBox txtIn 
      Appearance      =   0  'Flat
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "Segoe UI"
         Size            =   11.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   5415
      Left            =   3000
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   2
      Top             =   720
      Width           =   7455
   End
   Begin VB.TextBox txtName 
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "Segoe UI"
         Size            =   11.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   1440
      Width           =   2175
   End
   Begin VB.TextBox txtIP 
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "Segoe UI"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   120
      TabIndex        =   0
      Top             =   2280
      Width           =   2175
   End
   Begin MSWinsockLib.Winsock wsChat 
      Left            =   9960
      Top             =   6840
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Shape Shape10 
      BorderColor     =   &H00FFFFFF&
      Height          =   375
      Left            =   1440
      Top             =   2880
      Width           =   1095
   End
   Begin VB.Label Label_listen 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H0013E1A4&
      BackStyle       =   0  'Transparent
      Caption         =   "Listen"
      BeginProperty Font 
         Name            =   "Segoe UI"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000005&
      Height          =   375
      Left            =   1560
      TabIndex        =   17
      Top             =   2880
      Width           =   855
   End
   Begin VB.Shape Shape6 
      BorderColor     =   &H0013E1A4&
      Height          =   375
      Left            =   9360
      Top             =   240
      Width           =   975
   End
   Begin VB.Label Label_help 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "Help"
      BeginProperty Font 
         Name            =   "Segoe UI Semibold"
         Size            =   11.25
         Charset         =   0
         Weight          =   600
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0013E1A4&
      Height          =   495
      Left            =   9360
      TabIndex        =   16
      Top             =   240
      Width           =   975
   End
   Begin VB.Label Label_Header 
      BackStyle       =   0  'Transparent
      Caption         =   "LAN"
      BeginProperty Font 
         Name            =   "Segoe UI Semibold"
         Size            =   18
         Charset         =   0
         Weight          =   600
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   615
      Left            =   120
      TabIndex        =   15
      Top             =   120
      Width           =   855
   End
   Begin VB.Label Label4 
      BackStyle       =   0  'Transparent
      Caption         =   "Messenger"
      BeginProperty Font 
         Name            =   "Segoe UI Semilight"
         Size            =   18
         Charset         =   0
         Weight          =   350
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   735
      Left            =   840
      TabIndex        =   14
      Top             =   120
      Width           =   1935
   End
   Begin VB.Label Label1 
      BackColor       =   &H00FFFFFF&
      BackStyle       =   0  'Transparent
      Caption         =   "I.P. Address"
      BeginProperty Font 
         Name            =   "Segoe UI"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000B&
      Height          =   375
      Left            =   120
      TabIndex        =   4
      Top             =   1920
      Width           =   1455
   End
   Begin VB.Label Label2 
      BackColor       =   &H00FFFFFF&
      BackStyle       =   0  'Transparent
      Caption         =   "Chat ID"
      BeginProperty Font 
         Name            =   "Segoe UI"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000B&
      Height          =   375
      Left            =   120
      TabIndex        =   5
      Top             =   1080
      Width           =   2055
   End
   Begin VB.Label Label_close 
      Alignment       =   2  'Center
      BackColor       =   &H0013E1A4&
      BackStyle       =   0  'Transparent
      Caption         =   "Close"
      BeginProperty Font 
         Name            =   "Segoe UI Semibold"
         Size            =   9.75
         Charset         =   0
         Weight          =   600
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000B&
      Height          =   495
      Left            =   1560
      MousePointer    =   10  'Up Arrow
      TabIndex        =   9
      ToolTipText     =   "Close current connection"
      Top             =   7920
      Width           =   1095
   End
   Begin VB.Shape Shape3 
      BorderColor     =   &H8000000B&
      Height          =   495
      Left            =   1560
      Top             =   7800
      Width           =   1215
   End
   Begin VB.Shape Shape5 
      BorderColor     =   &H00FFFFFF&
      Height          =   375
      Left            =   120
      Top             =   2880
      Width           =   1095
   End
   Begin VB.Label Label_connect 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H0013E1A4&
      BackStyle       =   0  'Transparent
      Caption         =   "Connect"
      BeginProperty Font 
         Name            =   "Segoe UI"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000005&
      Height          =   375
      Left            =   240
      TabIndex        =   10
      Top             =   2880
      Width           =   855
   End
   Begin VB.Shape Shape7 
      BorderColor     =   &H00FFFFFF&
      Height          =   495
      Left            =   120
      Top             =   7800
      Width           =   1335
   End
   Begin VB.Label Label_history 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "History"
      BeginProperty Font 
         Name            =   "Segoe UI"
         Size            =   11.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   375
      Left            =   240
      TabIndex        =   13
      Top             =   7920
      Width           =   1095
   End
   Begin VB.Shape Shape2 
      BorderColor     =   &H0013E170&
      FillColor       =   &H0013E1A4&
      FillStyle       =   0  'Solid
      Height          =   8535
      Left            =   0
      Top             =   0
      Width           =   2895
   End
   Begin VB.Shape Shape9 
      BorderColor     =   &H0013E1A4&
      Height          =   375
      Left            =   9240
      Top             =   7920
      Width           =   975
   End
   Begin VB.Shape Shape8 
      BorderColor     =   &H0013E1A4&
      Height          =   375
      Left            =   9240
      Top             =   7320
      Width           =   975
   End
   Begin VB.Label Label_browse 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "Browse"
      BeginProperty Font 
         Name            =   "Segoe UI"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0013E1A4&
      Height          =   495
      Left            =   9120
      MousePointer    =   10  'Up Arrow
      TabIndex        =   12
      Top             =   7320
      Width           =   1215
   End
   Begin VB.Label Label_send 
      Alignment       =   2  'Center
      BackColor       =   &H0013E1A4&
      BackStyle       =   0  'Transparent
      Caption         =   "Send"
      BeginProperty Font 
         Name            =   "Segoe UI"
         Size            =   11.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0013E1A4&
      Height          =   495
      Left            =   9120
      TabIndex        =   11
      Top             =   7920
      Width           =   1215
   End
   Begin VB.Shape Shape4 
      BorderColor     =   &H0013E1A4&
      BorderWidth     =   2
      FillColor       =   &H0013E1A4&
      Height          =   2055
      Left            =   3120
      Top             =   6240
      Width           =   6015
   End
   Begin VB.Shape Shape1 
      BackColor       =   &H00FFFFFF&
      BackStyle       =   1  'Opaque
      BorderColor     =   &H00E0E0E0&
      FillColor       =   &H003C1135&
      Height          =   8655
      Left            =   2880
      Top             =   0
      Width           =   7815
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public index As Integer
Private Const DiscoveryPort As Long = 4111
Private Const ResponsePort As Long = 4111
Private Const TCP_ListenPort As Long = 1234
Private ServerIP As String
Private ServerPort As Long
Private txtFileName As String
Private FileData As Boolean
Public Peername As String

Private Sub AddText(ByVal text As String, ByRef Box As TextBox)
Box.text = Box.text & text & vbCrLf
Box.SelStart = Len(Box.text)
End Sub






Private Sub Form_Load()


 With wsUdp
        .Close
        .Protocol = sckUDPProtocol
        .RemoteHost = "255.255.255.255"
        .LocalPort = DiscoveryPort
        .RemotePort = ResponsePort
       '.Bind DiscoveryPort
        
    End With
    Status.text = "Listening..(not Connected.)"


End Sub




Private Sub Label_browse_Click()
cdOpen.ShowOpen
If vbOK Then
txtFileName = cdOpen.FileName
txtOut.text = txtFileName
End If
End Sub

Private Sub Label_close_Click() ' test
If wsChat.State = 7 Then
wsChat.SendData "msg|***connection closed by peer***"
Pause 500
End If
Status.text = CStr(wsChat.State)
Label_close.Enabled = False
Label_send.Enabled = False
txtName.Enabled = True
Label_listen.Enabled = True
Label_connect.Enabled = True
AddText "-----Connection Closed-----" & vbCrLf, txtIn
wsChat.Close
End Sub

Private Sub Label_connect_Click()

'If txtIP.text = "" Or txtName.text = "" Then
If txtName.text = "" Then
MsgBox "Please enter both IP and Alias Name", vbCritical, "Error"
txtName.SetFocus
Exit Sub
End If
On Error Resume Next
wsUdp.SendData "CLIENT|" & txtName.text
Status.text = "searching clients..."
'wsChat.Close
'wsChat.Connect txtIP.text, TCP_ListenPort
Label_close.Enabled = True
Label_listen.Enabled = False
Label_connect.Enabled = False
txtName.Enabled = False
End Sub



Private Sub Label_help_Click()
FrmHelp.Show
End Sub

Private Sub Label_history_Click()
Form2.Show
End Sub

Private Sub Label_listen_Click()
If txtName.text = "" Then
MsgBox "You must enter an alias first!", vbCritical, "Error!"
txtName.SetFocus
Exit Sub
End If
txtIP.text = wsChat.LocalIP
wsChat.Close
wsChat.LocalPort = TCP_ListenPort
wsChat.Listen
'cmdClose.Enabled = True
'cmdListen.Enabled = False
'cmdConnect.Enabled = False
Label_close.Enabled = True
Label_listen.Enabled = False
Label_connect.Enabled = False
txtName.Enabled = False
AddText "-----Waiting for connection-----", txtIn
End Sub

Private Sub Label_send_Click()
If wsChat.State = 7 And (Opttxt.Value = True) Then
Status.text = "txt sent.."
wsChat.SendData "msg|" & txtName.text & "|" & txtOut.text
AddText "[" & txtName & "]" & txtOut.text, txtIn
Main
Set rs = New ADODB.Recordset
rs.Open "insert into table2 values ('" & txtName.text & "','" & Peername & "','" & CStr(Date) & "','" & CStr(Time) & "','" & txtOut.text & "')", con, adOpenDynamic, adLockOptimistic
'MsgBox ("one record added successfully from datasend !")

txtOut.text = ""
txtOut.SetFocus
End If

If wsChat.State = 7 And (OptFileSend = True) Then
    Dim FName_Only As String
        If txtOut.text = "" Then
             MsgBox ("No file to send fella!!"), vbCritical
        Else
             If wsChat.State <> sckClosed Then
                 FName_Only = GetFileName(txtOut.text)
                
                 SendFile FName_Only
             End If
        End If
'If wsChat.State = 7 And (optHistory = True) Then
'Form2.Show
'End If
If wsChat.State <> 7 Then 'rewrite next lines with SendData in data_arrival procedure
Status.text = CStr(wsChat.State)
AddText "------------Connection closed by peer---------", txtIn
wsChat.Close
'cmdClose.Enabled = False
'cmdSend.Enabled = False
txtName.Enabled = True
'cmdListen.Enabled = True
'cmdConnect.Enabled = True
Label_close.Enabled = False
Label_send.Enabled = False
Label_listen.Enabled = True
Label_connect.Enabled = True

End If
End If 'till here rewrite in data_arrival
'MsgBox (Peername & Myname)
End Sub

Private Sub OptFileSend_Click()
If wsChat.State = sckConnected Then
txtOut.Locked = True
txtOut.Height = 350
Label_browse.Visible = True
Else
MsgBox ("Not connected to any peer!!")
OptFileSend.Value = False
End If

End Sub

Private Sub Opttxt_Click()
OptFileSend.Value = False

txtOut.Locked = False
txtOut.Height = 975
txtOut.text = ""
Label_browse.Visible = False
End Sub

Private Sub wsChat_Connect() ' review code
Do
DoEvents
Loop Until wsChat.State = sckConnected Or wsChat.State = sckError
If wsChat.State = sckConnected Then
AddText "-----Connection Established-----" & vbCrLf, txtIn
wsChat.SendData "Peer|" & txtName.text
Label_send.Enabled = True
txtName.Enabled = False
txtOut.SetFocus
AddText Myname & "     " & Peername, txtIn
Else
AddText "-----Connection Failed-----" & vbCrLf, txtIn
End If


End Sub



Private Sub wsChat_ConnectionRequest(ByVal requestID As Long) 'review code
wsChat.Close
wsChat.Accept requestID
AddText "-----Connection Established----" & vbCrLf, txtIn
Myname = txtName.text

Label_send.Enabled = True
txtName.Enabled = False
txtOut.SetFocus
End Sub



Private Sub wsChat_DataArrival(ByVal bytesTotal As Long)
Dim Command As String, NewArrival As String, Data As String, message As String, FileName As String
Static DataCnt As Long
Dim I As Integer
wsChat.GetData NewArrival, vbString
If Len(NewArrival) < MAX_CHUNK Then
If NewArrival Like "Peer|*" Then
    Peername = Split(NewArrival, "|")(1)
End If
If NewArrival Like "msg|*" Then
    Peername = Split(NewArrival, "|")(1)
    message = Split(NewArrival, "|")(2)
    AddText "[" & Peername & "]" & message, txtIn
    Main
    Set rs = New ADODB.Recordset
    rs.Open "insert into table2 values ('" & txtName.text & "','" & Peername & "','" & CStr(Date) & "','" & CStr(Time) & "','" & message & "')", con, adOpenDynamic, adLockOptimistic
    'MsgBox ("one record added successfully from data arrival")
End If
If NewArrival Like "cmd|*" Then

    Command = Split(NewArrival, "|")(1)
    
    
    
    Select Case Command
        Case "Accepted"
             bReplied = True
             Status = "Connected."
        Case "ServerClosed"
             'Form_Load
             wsChat.Close
        Case "OpenFile"
             Dim Fname As String
             
             FileName = Split(NewArrival, "|")(2)
             
             Status = "receiving.." & FileName
             Fname = App.Path & "\" & FileName
            Label_close.Enabled = False
             Open Fname For Binary As #1
             
        Case "CloseFile"
             Close #1
             Label_close.Enabled = True
             Status = "File Transfer complete..."
             Pause 1000
             Status = "Listening... (Connected)"
             DataCnt = 0
        Case Else 'error..
       
        Pause 200
             
    End Select
End If

Else

Data = NewArrival
        Put #1, , Data
        DataCnt = DataCnt + 1
        Status = "Recieving Data.. " & MAX_CHUNK * DataCnt & " Bytes"
End If

End Sub



Private Sub wsChat_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
If Number <> 0 Then
AddText "-----Error[" & Description & "]-----" & vbCrLf, txtIn
Call Label_close_Click
End If
End Sub

Private Sub wsUdp_DataArrival(ByVal bytesTotal As Long)
Dim MSG As String
    
   
    wsUdp.GetData MSG, vbString
    
    
    If MSG Like "CLIENT|*" Then
        Status.text = "online is :" & Split(MSG, "|")(0)
        wsUdp.SendData "SERVER|" & wsUdp.LocalIP & "," & TCP_ListenPort
    End If
    If MSG Like "SERVER|*" Then
        ServerIP = Split(Split(MSG, "|")(1), ",")(0)
        ServerPort = Val(Split(Split(MSG, "|")(1), ",")(1))
        
        If Len(ServerIP) > 0 And ServerPort > 0 Then
            With wsChat
                     .Close
                     .RemoteHost = ServerIP
                     .RemotePort = ServerPort
                     .Connect
    End With
        End If
    End If
End Sub

